home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0093_Fire Graphic.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-02-03  |  11.2 KB  |  335 lines
  1. {
  2. ---------------------------------------------------------------------------
  3.  
  4.     This is a PD source that I came across not too long ago.. It displays a
  5. simulation of flames or fire.. Its pretty good..
  6. }
  7.  
  8. {*        credit were given, however. If you have any improvements,       *}
  9. {*        find any bugs etc. mail me at mackey@aqueous.ml.csiro.au        *}
  10. {*        with MARK: in the subject header.                               *}
  11. {*                                                                        *}
  12. {*************************************************************************}
  13.  
  14.  
  15. uses crt;
  16. type bigarr=array[0..102,0..159] of integer;
  17. var f:bigarr;
  18.     i,j,k,l:word;
  19.     delta:integer;
  20.     pal:array[0..255,1..3] of byte;
  21.     ch:char;
  22.  
  23. procedure setmode13;
  24. assembler;
  25. asm
  26.   mov ax,13h
  27.   int 10h
  28. end;
  29.  
  30. procedure setpalette;
  31. var mapfile:text;
  32.     i,j:integer;
  33.  
  34. begin
  35.   assign(mapfile,'flames5.map');  {kludgy, but it works!}
  36.   reset(mapfile);
  37.   for i:=0 to 255 do
  38.   for j:=1 to 3 do
  39.   begin
  40.     read(mapfile,pal[i,j]);
  41.     pal[i,j]:=pal[i,j] shr 2;
  42.   end;
  43.   asm
  44.     mov si,offset pal
  45.     mov cx,768      {no of colour registers}
  46.     mov dx,03c8h
  47.     xor al,al     {First colour to change pal for = 0}
  48.     out dx,al
  49.     inc dx
  50. @1: outsb
  51.     dec cx        {safer than rep outsb}
  52.     jnz @1
  53.   end;
  54. end;
  55.  
  56. begin
  57.   setmode13;
  58.   setpalette;
  59.   randomize;
  60.   ch:=' ';
  61.   for i:=0 to 102 do
  62.   for j:=0 to 159 do
  63.     f[i,j]:=0;        {initialise array}
  64.  
  65.   repeat
  66.     asm                {move lines up, averaging}
  67.       mov cx,16159;    {no. elements to change}
  68.       mov di,offset f
  69.       add di,320   {di points to 1st element of f in upper row (320 bytes/row)}
  70. @1:
  71.       mov ax,ds:[di-2]
  72.       add ax,ds:[di]
  73.       add ax,ds:[di+2]
  74.       add ax,ds:[di+320]
  75.       shr ax,2     {divide by 4: average 4 elements of f}
  76.       jz @2
  77.       sub ax,1
  78. @2:   mov word ptr ds:[di-320],ax
  79.       add di,2
  80.       dec cx
  81.       jnz @1    {faster than _loop_ on 486}
  82.     end;
  83.  
  84.  
  85.     for j:=0 to 159 do  {set new bottom line}
  86.  
  87. --- Maximus 2.01wb
  88.  * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)
  89. ===========================================================================
  90.  BBS: Canada Remote Systems
  91. Date: 12-02-93 (17:42)             Number: 46962
  92. From: FIASAL JUMA                  Refer#: NONE
  93.   To: ALL                           Recvd: NO  
  94. Subj: Fire                           Conf: (1221) F-PASCAL
  95. ---------------------------------------------------------------------------
  96.  
  97.  
  98.        This is a PD source that I came across a while ago.. It simulates flames
  99. or fire.. its pretty good source..
  100.  
  101. program flames;
  102. {**************************************************************************}
  103. {*                                                                        *}
  104. {*    FLAMES by M.D.Mackey  (C) 1993                                      *}
  105. {*        This code released into the public domain. It may be freely     *}
  106. {*        used, distributed and modified. I would appreciate it if        *}
  107. {*        credit were given, however. If you have any improvements,       *}
  108. {*        find any bugs etc. mail me at mackey@aqueous.ml.csiro.au        *}
  109. {*        with MARK: in the subject header.                               *}
  110. {*                                                                        *}
  111. {**************************************************************************}
  112.  
  113.  
  114. uses crt;
  115.  
  116. Const pal : array [1..768] of Byte =( 0,  0,  0,  0,  0, 24,  0,  0, 24,  0,
  117. 0, 28,
  118.                           0,  0, 32,  0,  0, 32,  0,  0, 36,  0,  0, 40,
  119.                            8,  0, 40, 16,  0, 36, 24,  0, 36, 32,  0, 32,
  120.                           40,  0, 28, 48,  0, 28, 56,  0, 24, 64,  0, 20,
  121.                           72,  0, 20, 80,  0, 16, 88,  0, 16, 96,  0, 12,
  122.                          104,  0,  8,112,  0,  8,120,  0,  4,128,  0,  0,
  123.                          128,  0,  0,132,  0,  0,136,  0,  0,140,  0,  0,
  124.                          144,  0,  0,144,  0,  0,148,  0,  0,152,  0,  0,
  125.                          156,  0,  0,160,  0,  0,160,  0,  0,164,  0,  0,
  126.                          168,  0,  0,172,  0,  0,176,  0,  0,180,  0,  0,
  127.                          184,  4,  0,188,  4,  0,192,  8,  0,196,  8,  0,
  128.                          200, 12,  0,204, 12,  0,208, 16,  0,212, 16,  0,
  129.                          216, 20,  0,220, 20,  0,224, 24,  0,228, 24,  0,
  130.                          232, 28,  0,236, 28,  0,240, 32,  0,244, 32,  0,
  131.                          252, 36,  0,252, 36,  0,252, 40,  0,252, 40,  0,
  132.                          252, 44,  0,252, 44,  0,252, 48,  0,252, 48,  0,
  133.                          252, 52,  0,252, 52,  0,252, 56,  0,252, 56,  0,
  134.                          252, 60,  0,252, 60,  0,252, 64,  0,252, 64,  0,
  135.                          252, 68,  0,252, 68,  0,252, 72,  0,252, 72,  0,
  136.                          252, 76,  0,252, 76,  0,252, 80,  0,252, 80,  0,
  137.                          252, 84,  0,252, 84,  0,252, 88,  0,252, 88,  0,
  138.                          252, 92,  0,252, 96,  0,252, 96,  0,252,100,  0,
  139.                          252,100,  0,252,104,  0,252,104,  0,252,108,  0,
  140.                          252,108,  0,252,112,  0,252,112,  0,252,116,  0,
  141.                          252,116,  0,252,120,  0,252,120,  0,252,124,  0,
  142.                          252,124,  0,252,128,  0,252,128,  0,252,132,  0,
  143.                          252,132,  0,252,136,  0,252, 136,   0,252, 140,   0,
  144.                          252, 140,   0,252, 144,   0,252, 144,   0,252, 148,
  145. 0,
  146.                          252, 152,   0,252, 152,   0,252, 156,   0,252, 156,
  147. 0,
  148.                          252, 160,   0,252, 160,   0,252, 164,   0,252, 164,
  149. 0,
  150.                          252, 168,   0,252, 168,   0,252, 172,   0,252, 172,
  151. 0,
  152.                          252, 176,   0,252, 176,   0,252, 180,   0,252, 180,
  153. 0,
  154.                          252, 184,   0,252, 184,   0,252, 188,   0,252, 188,
  155. 0,
  156.                          252, 192,   0,252, 192,   0,252, 196,   0,252, 196,
  157. 0,
  158.                          252, 200,   0,252, 200,   0,252, 204,   0,252, 208,
  159. 0,
  160.                          252, 208,   0,252, 208,   0,252, 208,   0,252, 208,
  161. 0,
  162.                          252, 212,   0,252, 212,   0,252, 212,   0,252, 212,
  163. 0,
  164.                          252, 216,   0,252, 216,   0,252, 216,   0,252, 216,
  165. 0,
  166.                          252, 216,   0,252, 220,   0,252, 220,   0,252, 220,
  167. 0,
  168.                          252, 220,   0,252, 224,   0,252, 224,   0,252, 224,
  169. 0,
  170.                          252, 224,   0,252, 228,   0,252, 228,   0,252, 228,
  171. 0,
  172.                          252, 228,   0,252, 228,   0,252, 232,   0,252, 232,
  173. 0,
  174.                          252, 232,   0,252, 232,   0,252, 236,   0,252, 236,
  175. 0,
  176.                          252, 236,   0,252, 236,   0,252, 240,   0,252, 240,
  177. 0,
  178.  
  179. --- Maximus 2.01wb
  180.  * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)
  181. ===========================================================================
  182.  BBS: Canada Remote Systems
  183. Date: 12-02-93 (17:45)             Number: 46963
  184. From: FIASAL JUMA                  Refer#: NONE
  185.   To: ALL                           Recvd: NO  
  186. Subj: Fire II                        Conf: (1221) F-PASCAL
  187. ---------------------------------------------------------------------------
  188. Continue.....
  189.  
  190.                 252, 244,   0,252, 244,   0,252, 244,   0,252, 248,   0,
  191.                 252, 248,   0,252, 248,   0,252, 248,   0,252, 252,   0,
  192.                 252, 252,   4,252, 252,   8,252, 252,  12,252, 252,  16,
  193.                 252, 252,  20,252, 252,  24,252, 252,  28,252, 252,  32,
  194.                 252, 252,  36,252, 252,  40,252, 252,  40,252, 252,  44,
  195.                 252, 252,  48,252, 252,  52,252, 252,  56,252, 252,  60,
  196.                 252, 252,  64,252, 252,  68,252, 252,  72,252, 252,  76,
  197.                 252, 252,  80,252, 252,  84,252, 252,  84,252, 252,  88,
  198.                 252, 252,  92,252, 252,  96,252, 252, 100,252, 252, 104,
  199.                 252, 252, 108,252, 252, 112,252, 252, 116,252, 252, 120,
  200.                 252, 252, 124,252, 252, 124,252, 252, 128,252, 252, 132,
  201.                 252, 252, 136,252, 252, 140,252, 252, 144,252, 252, 148,
  202.                 252, 252, 152,252, 252, 156,252, 252, 160,252, 252, 164,
  203.                 252, 252, 168,252, 252, 168,252, 252, 172,252, 252, 176,
  204.                 252, 252, 180,252, 252, 184,252, 252, 188,252, 252, 192,
  205.                 252, 252, 196,252, 252, 200,252, 252, 204,252, 252, 208,
  206.                 252, 252, 208,252, 252, 212,252, 252, 216,252, 252, 220,
  207.                 252, 252, 224,252, 252, 228,252, 252, 232,252, 252, 236,
  208.                 252, 252, 240,252, 252, 244,252, 252, 248,252, 252, 252);
  209.  
  210.  
  211. type bigarr=array[0..102,0..159] of integer;
  212. var f:bigarr;
  213.     i,j,k,l:word;
  214.     delta:integer;
  215.     pal:array[0..255,1..3] of byte;
  216.     ch:char;
  217.  
  218. procedure setmode13;
  219. assembler;
  220. asm
  221.   mov ax,13h
  222.   int 10h
  223. end;
  224.  
  225. procedure setpalette;
  226. var mapfile:text;
  227.     i,j:integer;
  228.  
  229. begin
  230.   for j:=1 to 768 do
  231.   begin
  232.     pal[j]:=pal[j] shr 2;
  233.   end;
  234.  
  235.   asm
  236.     mov si,offset pal
  237.     mov cx,768
  238.     mov dx,03c8h
  239.     xor al,al
  240.     out dx,al
  241.     inc dx
  242. @1:
  243.     outsb
  244.     dec cx
  245.     jnz @1
  246.   end;
  247. end;
  248.  
  249. begin
  250.   setmode13;
  251.   setpalette;
  252.   randomize;
  253.   ch:=' ';
  254.   for i:=0 to 102 do
  255.   for j:=0 to 159 do
  256.     f[i,j]:=0;        {initialise array}
  257.  
  258.   repeat
  259.     asm                {move lines up, averaging}
  260.       mov cx,16159;    {no. elements to change}
  261.       mov di,offset f
  262.       add di,320   {di points to 1st element of f in upper row (320 bytes/row)}
  263. @1:
  264.       mov ax,ds:[di-2]
  265.       add ax,ds:[di]
  266.       add ax,ds:[di+2]
  267.       add ax,ds:[di+320]
  268.       shr ax,2     {divide by 4: average 4 elements of f}
  269.       jz @2
  270.       sub ax,1
  271. @2:   mov word ptr ds:[di-320],ax
  272.       add di,2
  273.       dec cx
  274.       jnz @1    {faster than _loop_ on 486}
  275.     end;
  276.  
  277.  
  278.     for j:=0 to 159 do  {set new bottom line}
  279.     begin
  280.       if random<0.4 then
  281.         delta:=random(2)*255;
  282.       f[101,j]:=delta;
  283.       f[102,j]:=delta;
  284.     end;
  285.  
  286. --- Maximus 2.01wb
  287.  * Origin: *THE K-W AMATEUR RADIO BBS-(VE3MTS)* ->DS16.8<- (1:221/177)
  288. ===========================================================================
  289.  BBS: Canada Remote Systems
  290. Date: 12-02-93 (17:47)             Number: 46964
  291. From: FIASAL JUMA                  Refer#: NONE
  292.   To: ALL                           Recvd: NO  
  293. Subj: Fire III                       Conf: (1221) F-PASCAL
  294. ---------------------------------------------------------------------------
  295. Continue..
  296.  
  297.     asm                 {output to screen}
  298.       mov si,offset f
  299.       mov ax,0a000h
  300.       mov es,ax
  301.       mov di,0
  302.       mov dx,100
  303. @3:
  304.       mov bx,2
  305. @2:
  306.       mov cx,160
  307. @1:
  308.       mov al,[si]
  309.       mov ah,al
  310.       mov es:[di],ax     {word aligned write to display mem}
  311.       add di,2
  312.       add si,2
  313.       dec cx
  314.       jnz @1
  315.  
  316.       sub si,320
  317.       dec bx
  318.       jnz @2
  319.  
  320.       add si,320
  321.       dec dx
  322.       jnz @3
  323.     end;
  324.     if keypressed then ch:=readkey;
  325.   until ch=#27;
  326.   asm   {restore text mode}
  327.     mov ax,03h
  328.     int 10h
  329.   end;
  330. end.
  331.  
  332.       There is a million things you can do to modify that code to look better
  333. or run faster.. Making it work in modex is one good possibility and its not
  334. that hard.. later
  335.